Dataset Preparation Notes
summary.raw <- read.xlsx(xlsxFile = glue('{params$data_dir}/{params$summary_data_file}'),
sheet = 'Survey Data',
colNames = FALSE,
skipEmptyCols = FALSE,
na.strings = c("NA", "Suppressed", ""),
fillMergedCells = TRUE)
# get good column names we can use
colnames(summary.raw) <- gsub('(%)', '', summary.raw[2, ], fixed = T) %>%
trimws() %>%
make.names(unique = T)
# hold onto "row" metadata, this is the communities/names
survey.col.meta <- summary.raw[1, , drop = F] %>%
t() %>% as.data.frame() %>%
rownames_to_column("Name") %>%
rename(Area = `1`)
# drop the old rows we used to make column names and index the metadata
summary.raw <- summary.raw[-(1:2), ]
# keep the first two columns when we sort out the part of the health data we want (LHA)
keep <- list("Domain" = 1, "Indicator" = 2)
# subset to the LHA columns
summary.lha <- summary.raw[, c(unlist(keep),
which(survey.col.meta$Area == "Sub Regions"))]
# match the LHA IDs for use with map regions
id_lookup <- read.xlsx(xlsxFile = glue('{params$data_dir}/{params$data_dictionary_file}'),
sheet = 'CHSA_LHA_HSDA_HA_lookup',
colNames = TRUE,
na.strings = c("NA", "Suppressed", ""),
fillMergedCells = TRUE) %>%
select(LHA, LHA_Name) %>%
mutate(LHA_Name = make.names(LHA_Name, unique = T))
# raw data
data <- summary.lha[, -unlist(keep)] %>% t() %>% as.data.frame()
colnames(data) <- make.names(colnames(data), unique = T)
# column/sample (location) annotations
smp.ann <- summary.lha[, names(keep)]
rownames(smp.ann) <- colnames(data)
# row/variable (indication) annotations
var.ann <- data.frame("LHA_Name" = rownames(data), stringsAsFactors = F) %>%
left_join(id_lookup, by = "LHA_Name")
rownames(var.ann) <- rownames(data)
#cleanup unused variables
# rm(summary.raw, survey.col.meta, id_lookup, keep, summary.lha)
GEO Data Notes Preparation Notes
Map boundary data was obtained from: https://www2.gov.bc.ca/gov/content/data/geographic-data-services/land-use/administrative-boundaries/health-boundaries
Data was downsampled to 1% of original using http://mapshaper.org
# lat/long geojson
boundaries.lha <- read_json(glue('{params$data_dir}/{params$lha_boundaries_file}'))
This visualization uses CanvasXpress (www.canvasxpress.org)
rownames(data) <- var.ann$LHA
rownames(var.ann) <- var.ann$LHA
sel <- c("X4", "X6", "X8")
data.sm <- data[, sel]
smp.sm <- smp.ann[sel, ]
var.sm <- var.ann
The below chart is the base chart, raw map data showing the various areas/etc that come by default on the shape file for LHA
# chart tooltip events
lha.events <- JS("{
'mousemove' : function(o, e, t) {
if (o) {
console.log(o);
t.showInfoSpan(e, '<b>' + o.z.LOCAL_HLTH_AREA_NAME[0] +
'</b> <i>(' + o.z.LOCAL_HLTH_AREA_CODE[0] + ')</i><br/>' +
'HA: ' + o.z.HLTH_AUTHORITY_NAME[0] +
' <i>(' + o.z.HLTH_AUTHORITY_CODE[0] + ')</i>');
};
}}")
# just show the map data (geojson)
# canvasXpress(
# data = FALSE,
# graphType = "Map",
# title = "Local Health Authorities (LHA)",
# showLegend = FALSE,
# topoJSON = boundaries.lha,
# colorBy = "LOCAL_HLTH_AUTHORITY_CODE",
# events = lha.events
# )
# with the added example data
# waiting on ID join, working with the CX author
# this will eventually be the way the chart is made
# canvasXpress(
# data = data.sm,
# varAnnot = var.sm,
# smpAnnot = smp.sm,
# graphType = "Map",
# mapPropertyId = "LOCAL_HLTH_AUTHORITY_CODE",
# title = "Local Health Authorities (LHA)",
# showLegend = FALSE,
# topoJSON = boundaries.lha,
# colorBy = "X4",
# events = lha.events
# )
I’ve joined the map data into the chart here and removed most of the default parameters/values.
# we can add the data directly to the map data for now until the library directly supports it
#NOTE: I'm not reformatting the data to make this easier because eventually it will be added to the
# CX call as in the above commented out call.
# add data to the map
features <- boundaries.lha$features
keep <- c(2, 3, 8, 9)
keep.prefix <- "_" # pull them to the top of the sorted list!
features.data <- lapply(features, FUN = function(x) {
new <- data[rownames(data) == x$properties$LOCAL_HLTH_AREA_CODE, ]
colnames(new) <- paste(smp.ann$Domain, smp.ann$Indicator, sep = ": ")
x$properties <- x$properties[keep]
names(x$properties) <- paste0(keep.prefix, names(x$properties))
x$properties <- append(x$properties, new[1, ])
x
})
boundaries.lha.data <- boundaries.lha
boundaries.lha.data$features <- features.data
lha.data.events <- JS("{
'mousemove' : function(o, e, t) {
if (o) {
t.showInfoSpan(e, '<b>' + this.colorBy + ': ' + o.z[this.colorBy] + '</b><hr/>' +
o.z._LOCAL_HLTH_AREA_NAME[0] + '<i>(' + o.z._LOCAL_HLTH_AREA_CODE[0] + ')</i><br/>' +
'Health Authority: ' + o.z._HLTH_AUTHORITY_NAME[0] + ' <i>(' + o.z._HLTH_AUTHORITY_CODE[0] + ')</i>');
};
}}")
canvasXpress(
data = FALSE,
graphType = "Map",
title = "SPEAK 1 Summary Data (%) by LHA",
subtitle = 'Right-Click and use the "Color By" menu to change the Domain:Indicator shown' ,
titleScaleFontFactor = 0.5,
subtitleScaleFontFactor = 0.3,
legendPosition = "bottom",
colorSpectrum = list("rgb(240, 240, 240)", "yellow", "orange", "red", "firebrick"),
colorSpectrumBreaks = list(0, 25, 50, 75, 100),
topoJSON = boundaries.lha.data,
colorBy = "Experience: Mental Health Worsening",
citation = "Note: Hover over chart areas to view detailed information",
citationScaleFontFactor = 2,
width = "800",
height = "800",
events = lha.data.events
)
Chart usage Tips
Right click on the map chart and go to “Color By” - all the Domains and Indicators are shown in the list and you can change around the color-by attribute. The scale is fixed (0-100) because it is important that while you explore different factors you don’t have to try to mentally shift what the colors mean.